home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / BP330 / !BinPro330 / library / matrix < prev    next >
Text File  |  1995-02-06  |  3KB  |  135 lines
  1. % Program: basic matrix manipulation package
  2. % Author: Paul Tarau, 1995
  3. % - argument for the vertues of an OR-intensive programming style
  4. %
  5. % THE POINT IS THAT WE CAN AVOID EXPLICIT ITERATION mainly because
  6. % an OR-intensive style is `compositional' in the sense that
  7. % it allows reuse of existing finite domain generators (i.e. for/3)
  8. % The alternative: endless functor+arg+ I1 is I+1 hacking.
  9.  
  10. % makes a new vector of MaxI elements V, such that V[I]=VI,
  11. % where VI is produced by generator Gen for each I
  12. newv(Name,MaxI,Gen,I,VI,V):-
  13.   findall(VI,(for(I,1,MaxI),Gen),VIs),
  14.   V=..[Name|VIs].
  15.  
  16. % makes a 2-dim matrix M of MaxI X MaxJ elements, such that M[I,J]=MIJ, 
  17. % where MIJ is produced by Gen for each I,J
  18. newm(MaxI,MaxJ,Gen,I,J,MIJ,M):-
  19.   newv(m,MaxI,
  20.        newv(v,MaxJ,(for(J,1,MaxJ),Gen),J,MIJ,V),
  21.        I,V,M).
  22.  
  23. % true iff M[I,J]=X
  24. aref(M,I,J,X):-arg(I,M,V),arg(J,V,X).
  25.  
  26. % true iff M has I rows and J columns
  27. dim(M,I,J):-
  28.   functor(M,_,I),
  29.   arg(1,M,V),
  30.   functor(V,_,J).
  31.  
  32. % M=M1+M2
  33. sum(M1,M2,M):-sum_like(+,M1,M2,M).
  34.  
  35. % M=M1-M2
  36. dif(M1,M2,M):-sum_like(-,M1,M2,M).
  37.  
  38. sum_like(Op,M1,M2,M):-
  39.   dim(M1,MaxI,MaxJ),
  40.   dim(M2,MaxI,MaxJ),
  41.   newm(MaxI,MaxJ,sumIJ(Op,M1,M2,I,J,X),I,J,X,M).
  42.  
  43. sumIJ(Op,M1,M2,I,J,X):-
  44.   aref(M1,I,J,X1),
  45.   aref(M2,I,J,X2),
  46.   call(Op,X1,X2,X).
  47.  
  48. % M = M1*M2
  49. prod(M1,M2,M):-prod_like(+,*,M1,M2,M).
  50.  
  51. max(X,Y,Z):-compare(R,X,Y),order(R,X,Y,_,Z).
  52.  
  53. min(X,Y,Z):-compare(R,X,Y),order(R,X,Y,Z,_).
  54.  
  55. order(<,X,Y,X,Y).
  56. order(=,X,Y,X,Y).
  57. order(>,X,Y,Y,X).
  58.  
  59. prod_like(SumOp,MultOp,M1,M2,M):-
  60.   dim(M1,MaxI,MaxK),
  61.   dim(M2,MaxK,MaxJ),
  62.   newm(MaxI,MaxJ,
  63.     fold(SumOp,P^prodIJ(MultOp,M1,M2,MaxK,I,J,P),X),
  64.   I,J,X,M).
  65.  
  66. prodIJ(Op,M1,M2,MaxK,I,J,X):-
  67.   for(K,1,MaxK),
  68.     aref(M1,I,K,X1),
  69.     aref(M2,K,J,X2),
  70.     call(Op,X1,X2,X).
  71.  
  72. % M is the unit square matrix of dim N
  73. id(N,M):-newm(N,N,(I=J->X=1;X=0),I,J,X,M).
  74.  
  75. % M is the 0 square matrix of dim N
  76. zero(N,M):-newm(N,N,X=0,_,_,X,M).
  77.  
  78. % KM is K times M, where K is a scalar
  79. times(K,M,KM):-
  80.   dim(M,MaxI,MaxJ),
  81.   newm(MaxI,MaxJ,(aref(M,I,J,X),KX is K*X),I,J,KX,KM).
  82.  
  83.  
  84. % tools
  85.  
  86. % combines 2 by 2 (with Closure) answers I of Generator
  87. % accumulating in Final the overall result 
  88.  
  89. fold(Closure,I^Generator,Final):-
  90.   term_append(Closure,args(SoFar,I,O),Selector),
  91.   fold0(SoFar,I,O,Generator,Selector,Final).
  92.  
  93. fold0(SoFar,I,O,Generator,Selector,_):-
  94.   inc_level(fold,Level),
  95.   Generator,
  96.   select_or_init(Selector,Level,SoFar,I,O),
  97.   fail.
  98. fold0(_,_,_,_,_,Final):-
  99.   dec_level(fold,Level),
  100.   bb_val(fold,Level,Final),
  101.   rm(fold,Level).
  102.  
  103. select_or_init(Selector,Level,SoFar,_,O):-
  104.   val(fold,Level,SoFar),!,
  105.   Selector,
  106.   bb_set(fold,Level,O).
  107. select_or_init(_,Level,_,I,_):-
  108.   bb_def(fold,Level,I).
  109.  
  110. % ensure correct implementation of embedded calls to fold/4
  111.  
  112. inc_level(Obj,X1):-val(Obj,Obj,X),!,X1 is X+1,set(Obj,Obj,X1).
  113. inc_level(Obj,1):-def(Obj,Obj,1).
  114.  
  115. dec_level(Obj,X):-val(Obj,Obj,X),X>0,X1 is X-1,set(Obj,Obj,X1).
  116.  
  117.  
  118.  
  119. test1:- 
  120.   newm(3,3,(X is (I+J)//2),I,J,X,M),write(M),nl,
  121.   sum(M,M,R),
  122.   times(10,R,RR),
  123.   write(R),nl,
  124.   write(RR),nl.
  125.  
  126. test2:-id(3,Id),newm(3,3,(X is I+J),I,J,X,M),
  127.   prod(M,Id,R),prod(Id,M,RR),
  128.   write(M),nl,
  129.   write(R),nl,
  130.   write(RR),nl.
  131.  
  132. % 
  133.  
  134.  
  135.